home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / gnu / emacs.lha / emacs-19.16 / lisp / appt.el < prev    next >
Lisp/Scheme  |  1992-09-21  |  20KB  |  518 lines
  1. ;;; appt.el --- appointment notification functions.
  2.  
  3. ;; Copyright (C) 1989, 1990 Free Software Foundation, Inc.
  4.  
  5. ;; Author: Neil Mager <neilm@juliet.ll.mit.edu>
  6. ;; Version: 2.1
  7. ;; Keywords: calendar
  8.  
  9. ;; This file is part of GNU Emacs.
  10.  
  11. ;; GNU Emacs is free software; you can redistribute it and/or modify
  12. ;; it under the terms of the GNU General Public License as published by
  13. ;; the Free Software Foundation; either version 2, or (at your option)
  14. ;; any later version.
  15.  
  16. ;; GNU Emacs is distributed in the hope that it will be useful,
  17. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  18. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  19. ;; GNU General Public License for more details.
  20.  
  21. ;; You should have received a copy of the GNU General Public License
  22. ;; along with GNU Emacs; see the file COPYING.  If not, write to
  23. ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  24.  
  25. ;;; Commentary:
  26.  
  27. ;;
  28. ;; appt.el - visible and/or audible notification of
  29. ;;           appointments from ~/diary file generated from
  30. ;;           Edward M. Reingold's calendar.el.
  31. ;;
  32. ;;
  33. ;; Comments, corrections, and improvements should be sent to
  34. ;; Neil M. Mager
  35. ;; Net                     <neilm@juliet.ll.mit.edu>
  36. ;; Voice                   (617) 981-4803
  37. ;;;
  38. ;;; Thanks to  Edward M. Reingold for much help and many suggestions, 
  39. ;;; And to many others for bug fixes and suggestions.
  40. ;;;
  41. ;;;
  42. ;;; This functions in this file will alert the user of a 
  43. ;;; pending appointment based on their diary file.
  44. ;;;
  45. ;;;
  46. ;;; ******* It is necessary to invoke 'display-time' ********
  47. ;;; *******  and 'diary' for this to work properly.  ********
  48. ;;; 
  49. ;;; A message will be displayed in the mode line of the emacs buffer
  50. ;;; and (if the user desires) the terminal will beep and display a message
  51. ;;; from the diary in the mini-buffer, or the user may select to 
  52. ;;; have a message displayed in a new buffer.
  53. ;;;
  54. ;;; The variable 'appt-message-warning-time' allows the
  55. ;;; user to specify how much notice they want before the appointment. The 
  56. ;;; variable 'appt-issue-message' specifies whether the user wants
  57. ;;; to to be notified of a pending appointment.
  58. ;;; 
  59. ;;; In order to use, the following should be in your .emacs file in addition to
  60. ;;; creating a diary file and invoking calendar:
  61. ;;;
  62. ;;;    Set some options
  63. ;;; (setq view-diary-entries-initially t)
  64. ;;; (setq appt-issue-message t)
  65. ;;;
  66. ;;;   The following three lines are required:
  67. ;;; (display-time)
  68. ;;; (autoload 'appt-make-list "appt.el" nil t)
  69. ;;; (setq diary-display-hook 
  70. ;;;     (list 'appt-make-list 'prepare-fancy-diary-buffer))
  71. ;;;
  72. ;;; 
  73. ;;;  This is an example of what can be in your diary file:
  74. ;;; Monday
  75. ;;;   9:30am Coffee break
  76. ;;;  12:00pm Lunch        
  77. ;;; 
  78. ;;; Based upon the above lines in your .emacs and diary files, 
  79. ;;; the calendar and diary will be displayed when you enter
  80. ;;; emacs and your appointments list will automatically be created.
  81. ;;; You will then be reminded at 9:20am about your coffee break
  82. ;;; and at 11:50am to go to lunch. 
  83. ;;;
  84. ;;; Use describe-function on appt-check for a description of other variables
  85. ;;; that can be used to personalize the notification system.
  86. ;;;
  87. ;;;  In order to add or delete items from todays list, use appt-add
  88. ;;;  and appt-delete.
  89. ;;;
  90. ;;;  Additionally, the appointments list is recreated automatically
  91. ;;;  at 12:01am for those who do not logout every day or are programming
  92. ;;;  late.
  93. ;;;
  94. ;;; Brief internal description - Skip this if your not interested!
  95. ;;;
  96. ;;; The function appt-check is run from the 'loadst' process which is started
  97. ;;; by invoking (display-time). A temporary function below modifies
  98. ;;; display-time-filter 
  99. ;;; (from original time.el) to include a hook which will invoke appt-check.
  100. ;;; This will not be necessary in the next version of gnuemacs.
  101. ;;;
  102. ;;;
  103. ;;; The function appt-make-list creates the appointments list which appt-check
  104. ;;; reads. This is all done automatically.
  105. ;;; It is invoked from the function list-diary-entries.
  106. ;;;
  107.  
  108. ;;; Code:
  109.  
  110. ;;;###autoload
  111. (defvar appt-issue-message t
  112.   "*Non-nil means check for appointments in the diary buffer.
  113. To be detected, the diary entry must have the time
  114. as the first thing on a line.")
  115.  
  116. ;;;###autoload
  117. (defvar appt-message-warning-time 10
  118.   "*Time in minutes before an appointment that the warning begins.")
  119.  
  120. ;;;###autoload
  121. (defvar appt-audible t
  122.   "*Non-nil means beep to indicate appointment.")
  123.  
  124. ;;;###autoload
  125. (defvar appt-visible t
  126.   "*Non-nil means display appointment message in echo area.")
  127.  
  128. ;;;###autoload
  129. (defvar appt-display-mode-line t
  130.   "*Non-nil means display minutes to appointment and time on the mode line.")
  131.  
  132. ;;;###autoload
  133. (defvar appt-msg-window t
  134.   "*Non-nil means display appointment message in another window.")
  135.  
  136. ;;;###autoload
  137. (defvar appt-display-duration 5
  138.   "*The number of seconds an appointment message is displayed.")
  139.  
  140. ;;;###autoload
  141. (defvar appt-display-diary t
  142.   "*Non-nil means to display the next days diary on the screen. 
  143. This will occur at midnight when the appointment list is updated.")
  144.  
  145. (defvar appt-time-msg-list nil
  146.   "The list of appointments for today.
  147. Use `appt-add' and `appt-delete' to add and delete appointments from list.
  148. The original list is generated from the today's `diary-entries-list'.
  149. The number before each time/message is the time in minutes from midnight.")
  150.  
  151. (defconst max-time 1439
  152.   "11:59pm in minutes - number of minutes in a day minus 1.")
  153.  
  154. (defun appt-check ()
  155.   "Check for an appointment and update the mode line.
  156. Note: the time must be the first thing in the line in the diary
  157. for a warning to be issued.
  158.  
  159. The format of the time can be either 24 hour or am/pm.
  160. Example: 
  161.  
  162.                02/23/89
  163.                  18:00 Dinner
  164.             
  165.               Thursday
  166.                 11:45am Lunch meeting.
  167.  
  168. The following variables control the action of the notification:
  169.  
  170. appt-issue-message
  171.         If T, the diary buffer is checked for appointments.
  172.  
  173. appt-message-warning-time
  174.        Variable used to determine if appointment message
  175.         should be displayed.
  176.  
  177. appt-audible
  178.         Variable used to determine if appointment is audible.
  179.         Default is t.
  180.  
  181. appt-visible
  182.         Variable used to determine if appointment message should be
  183.         displayed in the mini-buffer. Default is t.
  184.  
  185. appt-msg-window
  186.        Variable used to determine if appointment message
  187.        should temporarily appear in another window. Mutually exclusive
  188.        to appt-visible.
  189.  
  190. appt-display-duration
  191.       The number of seconds an appointment message
  192.       is displayed in another window.
  193.  
  194. This function is run from the loadst process for display time.
  195. Therefore, you need to have `(display-time)' in your .emacs file."
  196.  
  197.  
  198.   (let ((min-to-app -1)
  199.         (new-time ""))
  200.     (save-excursion
  201.       
  202.       ;; Get the current time and convert it to minutes
  203.       ;; from midnight. ie. 12:01am = 1, midnight = 0.
  204.       
  205.       (let* ((cur-hour(string-to-int 
  206.                        (substring (current-time-string) 11 13)))
  207.              (cur-min (string-to-int 
  208.                        (substring (current-time-string) 14 16)))
  209.              (cur-comp-time (+ (* cur-hour 60) cur-min)))
  210.         
  211.         ;; If the time is 12:01am, we should update our 
  212.         ;; appointments to todays list.
  213.         
  214.         (if (= cur-comp-time 1)
  215.             (if (and view-diary-entries-initially appt-display-diary)
  216.                 (diary)
  217.               (let ((diary-display-hook 'appt-make-list))
  218.                 (diary))))
  219.  
  220.         ;; If there are entries in the list, and the
  221.         ;; user wants a message issued
  222.         ;; get the first time off of the list
  223.         ;; and calculate the number of minutes until
  224.         ;; the appointment.
  225.         
  226.         (if (and appt-issue-message appt-time-msg-list)
  227.             (let ((appt-comp-time (car (car (car appt-time-msg-list)))))
  228.               (setq min-to-app (- appt-comp-time cur-comp-time))
  229.               
  230.               (while (and appt-time-msg-list 
  231.                           (< appt-comp-time cur-comp-time))
  232.                 (setq appt-time-msg-list (cdr appt-time-msg-list)) 
  233.                 (if appt-time-msg-list
  234.                     (setq appt-comp-time 
  235.                           (car (car (car appt-time-msg-list))))))
  236.               
  237.               ;; If we have an appointment between midnight and
  238.               ;; 'appt-message-warning-time' minutes after midnight,
  239.               ;; we must begin to issue a message before midnight.
  240.               ;; Midnight is considered 0 minutes and 11:59pm is
  241.               ;; 1439 minutes. Therefore we must recalculate the minutes
  242.               ;; to appointment variable. It is equal to the number of 
  243.               ;; minutes before midnight plus the number of 
  244.               ;; minutes after midnight our appointment is.
  245.               
  246.               (if (and (< appt-comp-time appt-message-warning-time)
  247.                        (> (+ cur-comp-time appt-message-warning-time)
  248.                           max-time))
  249.                   (setq min-to-app (+ (- (1+ max-time) cur-comp-time))
  250.                         appt-comp-time))
  251.               
  252.               ;; issue warning if the appointment time is 
  253.               ;; within appt-message-warning time
  254.               
  255.               (if (and (<= min-to-app appt-message-warning-time)
  256.                        (>= min-to-app 0))
  257.                   (progn
  258.                     (if appt-msg-window
  259.                         (progn
  260.                           (string-match
  261.                            "[0-9]?[0-9]:[0-9][0-9]\\(am\\|pm\\)?" 
  262.                            display-time-string)
  263.                           
  264.                           (setq new-time (substring display-time-string 
  265.                                                     (match-beginning 0)
  266.                                                     (match-end 0)))
  267.                           (appt-disp-window min-to-app new-time
  268.                                             (car (cdr (car appt-time-msg-list)))))
  269.                       ;;; else
  270.                       
  271.                       (if appt-visible
  272.                           (message "%s" 
  273.                                    (car (cdr (car appt-time-msg-list)))))
  274.                       
  275.                       (if appt-audible
  276.                           (beep 1)))
  277.                     
  278.                     (if appt-display-mode-line
  279.                         (progn
  280.                           (string-match
  281.                            "[0-9]?[0-9]:[0-9][0-9]\\(am\\|pm\\)?" 
  282.                            display-time-string)
  283.                           
  284.                           (setq new-time (substring display-time-string 
  285.                                                     (match-beginning 0)
  286.                                                     (match-end 0)))
  287.                           (setq display-time-string
  288.                                 (concat  "App't in "
  289.                                          min-to-app " min. " new-time " "))
  290.                           
  291.                           ;; force mode line updates - from time.el
  292.                           
  293.                           (save-excursion (set-buffer (other-buffer)))
  294.                           (set-buffer-modified-p (buffer-modified-p))
  295.                           (sit-for 0)))
  296.                     
  297.                     (if (= min-to-app 0)
  298.                         (setq appt-time-msg-list
  299.                               (cdr appt-time-msg-list)))))))))))
  300.  
  301.  
  302. ;; Display appointment message in a separate buffer.
  303. (defun appt-disp-window (min-to-app new-time appt-msg)
  304.   (require 'electric)
  305.   (save-window-excursion
  306.  
  307.     ;; Make sure we're not in the minibuffer
  308.     ;; before splitting the window.
  309.  
  310.     (if (= (frame-height)
  311.            (nth 3 (window-edges (selected-window))))
  312.         nil
  313.       (appt-select-lowest-window)
  314.       (split-window))
  315.  
  316.     (let* ((this-buffer (current-buffer))
  317.            (appt-disp-buf (set-buffer (get-buffer-create "appt-buf"))))
  318.       (setq mode-line-format 
  319.             (concat "-------------------- Appointment in "
  320.                     min-to-app " minutes. " new-time " %-"))
  321.       (pop-to-buffer appt-disp-buf)
  322.       (insert-string appt-msg)
  323.       (shrink-window-if-larger-than-buffer (get-buffer-window appt-disp-buf))
  324.       (set-buffer-modified-p nil)
  325.       (if appt-audible
  326.           (beep 1))
  327.       (sit-for appt-display-duration)
  328.       (if appt-audible
  329.           (beep 1))
  330.       (kill-buffer appt-disp-buf))))
  331.  
  332. ;; Select the lowest window on the frame.
  333. (defun appt-select-lowest-window ()
  334.   (setq lowest-window (selected-window))
  335.   (let* ((bottom-edge (car (cdr (cdr (cdr (window-edges))))))
  336.          (last-window (previous-window))
  337.          (window-search t))
  338.     (while window-search
  339.       (let* ((this-window (next-window))
  340.              (next-bottom-edge (car (cdr (cdr (cdr 
  341.                                                (window-edges this-window)))))))
  342.         (if (< bottom-edge next-bottom-edge)
  343.             (progn
  344.               (setq bottom-edge next-bottom-edge)
  345.               (setq lowest-window this-window)))
  346.  
  347.         (select-window this-window)
  348.         (if (eq last-window this-window)
  349.             (progn
  350.               (select-window lowest-window)
  351.               (setq window-search nil)))))))
  352.  
  353.  
  354. (defun appt-add (new-appt-time new-appt-msg)
  355.   "Add an appointment for the day at TIME and issue MESSAGE.
  356. The time should be in either 24 hour format or am/pm format."
  357.  
  358.   (interactive "sTime (hh:mm[am/pm]): \nsMessage: ")
  359.   (if (string-match "[0-9]?[0-9]:[0-9][0-9]\\(am\\|pm\\)?" new-appt-time)
  360.       nil
  361.     (error "Unacceptable time-string"))
  362.   
  363.   (let* ((appt-time-string (concat new-appt-time " " new-appt-msg))
  364.          (appt-time (list (appt-convert-time new-appt-time)))
  365.          (time-msg (cons appt-time (list appt-time-string))))
  366.     (setq appt-time-msg-list (append appt-time-msg-list
  367.                                      (list time-msg)))
  368.     (setq appt-time-msg-list (appt-sort-list appt-time-msg-list)))) 
  369.  
  370. (defun appt-delete ()
  371.   "Delete an appointment from the list of appointments."
  372.   (interactive)
  373.   (let* ((tmp-msg-list appt-time-msg-list))
  374.     (while tmp-msg-list
  375.       (let* ((element (car tmp-msg-list))
  376.              (prompt-string (concat "Delete " 
  377.                                     (prin1-to-string (car (cdr element))) 
  378.                                     " from list? "))
  379.              (test-input (y-or-n-p prompt-string)))
  380.         (setq tmp-msg-list (cdr tmp-msg-list))
  381.         (if test-input
  382.             (setq appt-time-msg-list (delq element appt-time-msg-list)))
  383.         (setq tmp-appt-msg-list nil)))
  384.     (message "")))
  385.                  
  386.  
  387. ;; Create the appointments list from todays diary buffer.
  388. ;; The time must be at the beginning of a line for it to be
  389. ;; put in the appointments list.
  390. ;;                02/23/89
  391. ;;                  12:00pm lunch
  392. ;;                 Wednesday
  393. ;;                   10:00am group meeting"
  394.  
  395. ;;;###autoload
  396. (defun appt-make-list ()
  397.   (setq appt-time-msg-list nil)
  398.  
  399.   (save-excursion
  400.     (if diary-entries-list
  401.  
  402.         ;; Cycle through the entry-list (diary-entries-list)
  403.         ;; looking for entries beginning with a time. If 
  404.         ;; the entry begins with a time, add it to the
  405.         ;; appt-time-msg-list. Then sort the list.
  406.         
  407.         (let ((entry-list diary-entries-list)
  408.               (new-time-string ""))
  409.           (while (and entry-list 
  410.                       (calendar-date-equal 
  411.                        (calendar-current-date) (car (car entry-list))))
  412.             (let ((time-string (substring (prin1-to-string 
  413.                                            (cdr (car entry-list))) 2 -2)))
  414.               
  415.               (while (string-match
  416.                       "[0-9]?[0-9]:[0-9][0-9]\\(am\\|pm\\)?.*" 
  417.                       time-string)
  418.                 (let* ((appt-time-string (substring time-string
  419.                                                     (match-beginning 0)
  420.                                                     (match-end 0))))
  421.  
  422.                   (if (< (match-end 0) (length time-string))
  423.                       (setq new-time-string (substring time-string 
  424.                                                        (+ (match-end 0) 1)
  425.                                                        nil))
  426.                     (setq new-time-string ""))
  427.                   
  428.                   (string-match "[0-9]?[0-9]:[0-9][0-9]\\(am\\|pm\\)?"
  429.                                 time-string)
  430.                     
  431.                   (let* ((appt-time (list (appt-convert-time 
  432.                                            (substring time-string
  433.                                                       (match-beginning 0)
  434.                                                       (match-end 0)))))
  435.                          (time-msg (cons appt-time
  436.                                          (list appt-time-string))))
  437.                     (setq time-string new-time-string)
  438.                     (setq appt-time-msg-list (append appt-time-msg-list
  439.                                                      (list time-msg)))))))
  440.             (setq entry-list (cdr entry-list)))))
  441.   (setq appt-time-msg-list (appt-sort-list appt-time-msg-list))
  442.  
  443.   ;; Get the current time and convert it to minutes
  444.   ;; from midnight. ie. 12:01am = 1, midnight = 0,
  445.   ;; so that the elements in the list
  446.   ;; that are earlier than the present time can
  447.   ;; be removed.
  448.   
  449.   (let* ((cur-hour(string-to-int 
  450.                    (substring (current-time-string) 11 13)))
  451.          (cur-min (string-to-int 
  452.                    (substring (current-time-string) 14 16)))
  453.          (cur-comp-time (+ (* cur-hour 60) cur-min))
  454.          (appt-comp-time (car (car (car appt-time-msg-list)))))
  455.  
  456.     (while (and appt-time-msg-list (< appt-comp-time cur-comp-time))
  457.       (setq appt-time-msg-list (cdr appt-time-msg-list)) 
  458.       (if appt-time-msg-list
  459.           (setq appt-comp-time (car (car (car appt-time-msg-list)))))))))
  460.   
  461.  
  462. ;;Simple sort to put the appointments list in order.
  463. ;;Scan the list for the smallest element left in the list.
  464. ;;Append the smallest element left into the new list, and remove
  465. ;;it from the original list.
  466. (defun appt-sort-list (appt-list)
  467.   (let ((order-list nil))
  468.     (while appt-list
  469.       (let* ((element (car appt-list))
  470.              (element-time (car (car element)))
  471.              (tmp-list (cdr appt-list)))
  472.         (while tmp-list
  473.           (if (< element-time (car (car (car tmp-list))))
  474.               nil
  475.             (setq element (car tmp-list))
  476.             (setq element-time (car (car element))))
  477.           (setq tmp-list (cdr tmp-list)))
  478.         (setq order-list (append order-list (list element)))
  479.         (setq appt-list (delq element appt-list))))
  480.     order-list))
  481.  
  482.  
  483. (defun appt-convert-time (time2conv)
  484.   "Convert hour:min[am/pm] format to minutes from midnight."
  485.  
  486.   (let ((conv-time 0)
  487.         (hr 0)
  488.         (min 0))
  489.  
  490.     (string-match ":[0-9][0-9]" time2conv)
  491.     (setq min (string-to-int 
  492.                (substring time2conv 
  493.                           (+ (match-beginning 0) 1) (match-end 0))))
  494.   
  495.     (string-match "[0-9]?[0-9]:" time2conv)
  496.     (setq hr (string-to-int 
  497.               (substring time2conv 
  498.                          (match-beginning 0)
  499.                          (match-end 0))))
  500.   
  501.     ;; convert the time appointment time into 24 hour time
  502.   
  503.     (if (and (string-match  "[p][m]" time2conv) (< hr 12))
  504.         (progn
  505.           (string-match "[0-9]?[0-9]:" time2conv)
  506.           (setq hr (+ 12 hr))))
  507.   
  508.     ;; convert the actual time
  509.     ;; into minutes for comparison
  510.     ;; against the actual time.
  511.   
  512.     (setq conv-time (+ (* hr 60) min))
  513.     conv-time))
  514.  
  515. (setq display-time-hook 'appt-check)
  516.  
  517. ;;; appt.el ends here
  518.